Small-n Design Project

# Load libraries
library(tidyverse)

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.2     ✔ tibble    3.2.1
## ✔ lubridate 1.9.4     ✔ tidyr     1.3.1
## ✔ purrr     1.0.4     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

# Study Overview
# This study evaluates the effectiveness of a motion-activated LED sash 
# in increasing pedestrian visibility and perceived safety using a small-n ABAB design.

# Design Overview
design_description <- tibble::tribble(
  ~Phase, ~Description,
  "A1", "Baseline: Dim LED only",
  "B1", "Intervention: Motion-activated LEDs",
  "A2", "Return to Baseline",
  "B2", "Reintroduce Intervention"
)
design_description

## # A tibble: 4 × 2
##   Phase Description                        
##   <chr> <chr>                              
## 1 A1    Baseline: Dim LED only             
## 2 B1    Intervention: Motion-activated LEDs
## 3 A2    Return to Baseline                 
## 4 B2    Reintroduce Intervention

# d Data (12 trials) 
# 3 full ABAB cycles
data <- tibble::tribble(
  ~trial, ~phase, ~cars_yielded, ~visibility_rating, ~felt_safe,
      1,   "A1",   1,              2,                 4,
      2,   "A1",   2,              2,                 3,
      3,   "A1",   1,              1,                 4,
      4,   "B1",   4,              4,                 7,
      5,   "B1",   5,              5,                 8,
      6,   "B1",   4,              4,                 9,
      7,   "A2",   2,              2,                 3,
      8,   "A2",   1,              1,                 2,
      9,   "A2",   1,              2,                 3,
     10,   "B2",   5,              5,                 9,
     11,   "B2",   4,              4,                 8,
     12,   "B2",   5,              5,                 9
)
data

## # A tibble: 12 × 5
##    trial phase cars_yielded visibility_rating felt_safe
##    <dbl> <chr>        <dbl>             <dbl>     <dbl>
##  1     1 A1               1                 2         4
##  2     2 A1               2                 2         3
##  3     3 A1               1                 1         4
##  4     4 B1               4                 4         7
##  5     5 B1               5                 5         8
##  6     6 B1               4                 4         9
##  7     7 A2               2                 2         3
##  8     8 A2               1                 1         2
##  9     9 A2               1                 2         3
## 10    10 B2               5                 5         9
## 11    11 B2               4                 4         8
## 12    12 B2               5                 5         9

# Cars yielded by phase
ggplot(data, aes(x = phase, y = cars_yielded)) +
  geom_boxplot(fill = "#0073C2FF") +
  labs(title = "Cars Yielded by Phase", x = "Phase", y = "Number of Cars Yielded") +
  theme_minimal()

# Visibility rating by phase
ggplot(data, aes(x = phase, y = visibility_rating)) +
  geom_boxplot(fill = "lightgreen") +
  labs(title = "Visibility Rating by Phase", y = "Visibility (1–5)", x = "Phase") +
  theme_minimal()

# Perceived safety
ggplot(data, aes(x = phase, y = felt_safe)) +
  geom_boxplot(fill = "orange") +
  labs(title = "Perceived Safety by Phase", y = "Safety Rating (1–10)", x = "Phase") +
  theme_minimal()

# Summary stats by phase
data |>
  group_by(phase) |>
  summarise(
    avg_yield = mean(cars_yielded),
    avg_visibility = mean(visibility_rating),
    avg_safety = mean(felt_safe),
    .groups = "drop"
  )

## # A tibble: 4 × 4
##   phase avg_yield avg_visibility avg_safety
##   <chr>     <dbl>          <dbl>      <dbl>
## 1 A1         1.33           1.67       3.67
## 2 A2         1.33           1.67       2.67
## 3 B1         4.33           4.33       8   
## 4 B2         4.67           4.67       8.67

The analysis of 12 trials (4 differenbt partcipants tested 3 times each) across an ABAB repeated-measures design reveals consistent and meaningful improvements in pedestrian safety metrics when the motion-activated sash was in use. During baseline phases (A1 and A2), where only constant dim lighting was used, the average number of cars yielding to the pedestrian was low at 1.33 per trial. This contrasts sharply with intervention phases (B1 and B2), where the addition of motion-triggered bright LEDs led to a significant increase in driver responsiveness, with average yields rising to 4.33 and 4.67.

Visibility ratings followed a similar trend. In both baseline phases, the average visibility score was 1.67 (on a 1–5 scale), suggesting poor detectability. This improved substantially in the intervention phases, with visibility scores increasing to 4.33 in B1 and 4.67 in B2, indicating that the motion-activated lighting greatly enhanced pedestrian conspicuity.

Perceived safety, measured on a 1–10 scale, also improved. Participants reported an average safety score of 3.67 and 2.67 during the A1 and A2 phases, respectively, compared to significantly higher ratings of 8.00 in B1 and 8.67 in B2. These results suggest that the sash not only increases visibility to drivers but also boosts pedestrian confidence and sense of security.

Taken together, the findings strongly support the effectiveness of the motion-activated sash as a behavioral safety intervention. The consistent improvement in all outcome measures across phases indicates a clear functional relation between the intervention and increased safety, consistent with prior research on pedestrian safety motion-triggered visibility aids.